home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgLangD.iso / TURBOPASCAL WIN / OWLDEMOS.PAK / SERVRWIN.PAS < prev    next >
Pascal/Delphi Source File  |  1992-06-08  |  12KB  |  413 lines
  1. {***************************************************}
  2. {                                                   }
  3. {   Turbo Pascal for Windows                        }
  4. {   Windows 3.1 OLE Server Demonstration Program    }
  5. {               Server Window Unit                  }
  6. {                                                   }
  7. {   Copyright (c) 1992 by Borland International     }
  8. {                                                   }
  9. {***************************************************}
  10.  
  11. { This unit implements the main window for the OLE Server
  12.   demo application.  This is the window which manages the
  13.   display and modification of the supported OLE objects.
  14.  
  15.   Note: To compile the OLE Server demo, set Compile|Primary File to OLESERVR.PAS
  16. }
  17.  
  18. unit ServrWin;
  19.  
  20. interface
  21.  
  22. uses WinTypes, WinProcs, WObjects, OleTypes;
  23.  
  24. type
  25.  
  26. { Type used to communicate the result of File I/O dialogs.
  27. }
  28.   TFileIoStatus = (fiCancel, fiExecute);
  29.  
  30. { Application Main Window }
  31.  
  32.   PServerWindow = ^TServerWindow;
  33.   TServerWindow = object(TWindow)
  34.     constructor Init(AParent: PWindowsObject; ATitle: PChar);
  35.  
  36.     function  CanClose: Boolean; virtual;
  37.     procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct); virtual;
  38.     procedure DefCommandProc(var Msg: TMessage); virtual;
  39.  
  40.     procedure BeginEmbedding; virtual;
  41.     procedure EndEmbedding; virtual;
  42.     function  SaveChangesPrompt: TFileIoStatus; virtual;
  43.     procedure ShapeChange(NewType: TNativeType); virtual;
  44.     procedure UpdateFileMenu(DocName: PChar); virtual;
  45.  
  46.     procedure CMFileNew(var Msg: TMessage);
  47.       virtual cm_First + cm_FileNew;
  48.     procedure CMFileOpen(var Msg: TMessage);
  49.       virtual cm_First + cm_FileOpen;
  50.     procedure CMFileSave(var Msg: TMessage);
  51.       virtual cm_First + cm_FileSave;
  52.     procedure CMFileSaveAs(var Msg: TMessage);
  53.       virtual cm_First + cm_FileSaveAs;
  54.     procedure CMFileUpdate(var Msg: TMessage);
  55.       virtual cm_First + cm_FileUpdate;
  56.     procedure CMEditCopy(var Msg: TMessage);
  57.       virtual cm_First + cm_EditCopy;
  58.     procedure CMHelpAbout(var Msg: TMessage); 
  59.       virtual cm_First + cm_HelpAbout;
  60.   end;
  61.  
  62. implementation
  63.  
  64. uses Ole, Strings, OleApp, Server, OleObj;
  65.  
  66. { Initialized globals }
  67.  
  68. const
  69.   CmToNativeType: array[cm_ShapeEllipse..cm_ShapeTriangle] of TNativeType
  70.                     = (ObjEllipse, ObjRect, ObjTriangle);
  71.  
  72.   NativeTypeToCm: array[TNativeType] of Word
  73.                     = (cm_ShapeEllipse, cm_ShapeRectangle, cm_ShapeTriangle);
  74.  
  75.  
  76. { TServerWindow Methods }
  77.  
  78. constructor TServerWindow.Init(AParent: PWindowsObject; ATitle: PChar);
  79. begin
  80.   TWindow.Init(AParent, ATitle);
  81.   Attr.Menu := LoadMenu(HInstance, PChar(id_Menu));
  82.   Attr.X    := 100;
  83.   Attr.Y    := 100;
  84.   Attr.W    := 250;
  85.   Attr.H    := 250;
  86. end;
  87.  
  88. { Prompts the user to save changes in the document and return,
  89.   and whether the pending operation (new/open/exit) should be
  90.   executed or canceled.  The user has requested File/New,
  91.   File/Open, or File/Exit.
  92. }
  93. function TServerWindow.SaveChangesPrompt: TFileIoStatus;
  94. var
  95.   App     : POleApp;
  96.   Doc     : POleDocument;
  97.   Outcome : Integer;
  98.   Buf     : array [0..127] of Char;
  99. begin
  100.   App := POLEApp(Application);
  101.   Doc := App^.Server^.Document;
  102.   Outcome := IdYes;
  103.  
  104.   if Doc^.IsDirty then
  105.   begin
  106.     if Doc^.DocType = DoctypeEmbedded then
  107.     begin
  108.       StrCopy(Buf, 'Embedded object ');
  109.       StrCat (Buf, Doc^.Name);
  110.       StrCat (Buf, ' has changed. Do you want to update?');
  111.     end
  112.     else
  113.     begin
  114.       StrCopy(Buf, 'Do you want to save changes to ');
  115.       StrCat (Buf, Doc^.Name);
  116.       StrCat (Buf, '?');
  117.     end;
  118.  
  119.     Outcome := MessageBox(HWindow, Buf, App^.Name, mb_IconQuestion or
  120.       mb_YesNoCancel);
  121.  
  122.     if Outcome = IdYes then
  123.       if Doc^.DocType = DoctypeEmbedded then
  124.         OleSavedServerDoc(Doc^.ServerDoc)
  125.       else
  126.         Doc^.SaveDoc;
  127.   end;
  128.  
  129.   if Outcome <> IdCancel then
  130.   begin
  131.     { If the server library is in the process of closing down
  132.       connections to the document, wait until it is finished
  133.       (flag "IsReleased" becomes True) before we re-use the
  134.       document space.
  135.     }
  136.     if OleRevokeServerDoc(Doc^.ServerDoc) = ole_Wait_For_Release then
  137.       App^.Wait(Doc^.IsReleased);
  138.  
  139.     Doc^.ServerDoc := 0;
  140.  
  141.     if Doc^.DocType = DoctypeEmbedded then
  142.       EndEmbedding;
  143.   end;
  144.  
  145.   if Outcome = IdCancel then
  146.     SaveChangesPrompt := fiCancel
  147.   else
  148.     SaveChangesPrompt := fiExecute;
  149. end;
  150.  
  151. { Prompts the user for changes and initiate application shutdown by
  152.   calling OleRevokeServer.  OleRevokeServer automatically revokes any
  153.   documents which revokes any objects.
  154. }
  155. function TServerWindow.CanClose: Boolean;
  156. var
  157.   App   : POLEApp;
  158.   Server: POleServerObj;
  159. begin
  160.   App   := POleApp(Application);
  161.   Server:= App^.Server;
  162.  
  163.   if SaveChangesPrompt = fiExecute then
  164.   begin
  165.     { If the server library is in the process of closing down
  166.       connections to the server, wait until it is finished (flag
  167.       "IsReleased" becomes True) before we terminate
  168.     }
  169.    if OleRevokeServer(Server^.ServerHdl) = ole_Wait_for_Release then
  170.       App^.Wait(Server^.IsReleased);
  171.     CanClose := True;
  172.   end
  173.   else
  174.     CanClose := False;
  175. end;
  176.  
  177. { Rather than have a message response function for each menu item on the
  178.   "Shape" menu we catch the commands here instead.  Other commands are 
  179.   passed to our inherited method.
  180. }
  181. procedure TServerWindow.DefCommandProc(var Msg: TMessage);
  182. begin
  183.   if (Msg.WParam >= cm_ShapeEllipse) and
  184.       (Msg.WParam <= cm_ShapeTriangle) then
  185.     ShapeChange(CmToNativeType[Msg.WParam])
  186.   else
  187.     TWindow.DefCommandProc(Msg);
  188. end;
  189.  
  190. { Responds to selection of the File/New menu item.
  191. }
  192. procedure TServerWindow.CMFileNew(var Msg: TMessage);
  193. begin
  194.   if SaveChangesPrompt = fiExecute then
  195.     POleApp(Application)^.Server^.Document^.Reset(nil);
  196. end;
  197.  
  198. { Responds to selection of the File/Open menu item.
  199. }
  200. procedure TServerWindow.CMFileOpen(var Msg: TMessage);
  201. var
  202.   Path: TFilename;
  203.   Doc : POleDocument;
  204. begin
  205.   Doc := POleApp(Application)^.Server^.Document;
  206.   if SaveChangesPrompt = fiExecute then
  207.   begin
  208.     if Doc^.PromptForOpenFileName(Path) then
  209.       Doc^.Reset(Path)
  210.     else
  211.       Doc^.Reset(nil);
  212.   end;
  213. end;
  214.  
  215. { Responds to selection of the File/Save menu item.
  216.   NOTE: This is only for stand-alone mode, when we're not
  217.   linked.
  218. }
  219. procedure TServerWindow.CMFileSave(var Msg: TMessage);
  220. begin
  221.   POleApp(Application)^.Server^.Document^.SaveDoc;
  222. end;
  223.  
  224. { Responds to selection of the File/SaveAs menu item.
  225. }
  226. procedure TServerWindow.CMFileSaveAs(var Msg: TMessage);
  227. begin
  228.   POleApp(Application)^.Server^.Document^.SaveAs;
  229. end;
  230.  
  231. { Responds to selection of the File/Update menu item.
  232.   NOTE: This is only for embedding mode.
  233. }
  234. procedure TServerWindow.CMFileUpdate(var Msg: TMessage);
  235. var
  236.   Doc: POleDocument;
  237. begin
  238.   Doc := POleApp(Application)^.Server^.Document;
  239.  
  240.   { Notify the server library that the embedded document
  241.     has changed
  242.   }
  243.   OleSavedServerDoc(Doc^.ServerDoc);
  244.   Doc^.IsDirty := False;
  245. end;
  246.  
  247. { Copies the object to the clipoard.  NOTE: since this app only has one
  248.   object we don't support "Cut" and "Delete", but your app might want to.
  249. }
  250. procedure TServerWindow.CMEditCopy(var Msg: TMessage);
  251. var
  252.   App      : POleApp;
  253.   ObjectPtr: POleObjectObj;
  254.   Handle   : THandle;
  255. begin
  256.   App      := POLEApp(Application);
  257.   ObjectPtr:= App^.Server^.Document^.OleObject;
  258.  
  259.   if OpenClipboard(HWindow) then
  260.   begin
  261.     EmptyClipboard;
  262.  
  263.     { Server applications are responsible for placing the data formats
  264.       on the clipboard in most important order first.  Here is the standard
  265.       ordering:
  266.         1. Application-specific data
  267.         2. Native
  268.         3. OwnerLink
  269.         4. cf_MetafilePict
  270.         5. cf_Bitmap
  271.         6. ObjectLink
  272.         7. Any other data
  273.     
  274.      add Native first...
  275.     }
  276.     Handle := ObjectPtr^.GetNativeData;
  277.     if Handle <> 0 then
  278.       SetClipboardData(App^.cfNative, Handle);
  279.  
  280.     { In order for the object to be embedded we must also identify the
  281.       owner of the object using "OwnerLink" data
  282.     }
  283.     Handle := ObjectPtr^.GetLinkData;
  284.     if Handle <> 0 then
  285.       SetClipboardData(App^.cfOwnerLink, Handle);
  286.  
  287.     { Now offer at least one presentation format.  If the server doesn't
  288.       have an object handler DLL then it must provide a metafile.
  289.     }
  290.     Handle := ObjectPtr^.GetMetafilePicture;
  291.     if Handle <> 0 then
  292.       SetClipboardData(cf_MetafilePict, Handle);
  293.  
  294.     { Now offer bitmap format.
  295.     }
  296.     Handle := ObjectPtr^.GetBitmapData;
  297.     if Handle <> 0 then
  298.       SetClipboardData(cf_Bitmap, Handle);
  299.  
  300.     { If the document type is a file then we can offer 'ObjectLink'.
  301.     }
  302.     if (App^.Server^.Document^.DocType = DoctypeFromFile) then
  303.     begin
  304.       Handle := ObjectPtr^.GetLinkData;
  305.       if Handle <> 0 then
  306.         SetClipboardData(App^.cfObjectLink, Handle);
  307.     end;
  308.  
  309.     CloseClipboard;
  310.   end;
  311. end;
  312.  
  313. { Activates the Help dialog.
  314. }
  315. procedure TServerWindow.CMHelpAbout(var Msg: TMessage);
  316. begin
  317.   Application^.ExecDialog(New(PDialog, Init(@Self, PChar(id_About))));
  318. end;
  319.  
  320. { Responds to selection of a menu item from the "Shape" menu.  Checks the
  321.   new menu item, unchecks the previous menu item, changes the selected 
  322.   object's type, repaints the damaged area, and checks the menu items to
  323.   see if they should be enabled/disabled.
  324. }
  325. procedure TServerWindow.ShapeChange(NewType: TNativeType);
  326. var
  327.   DocPtr   : POleDocument;
  328.   ObjectPtr: POleObjectObj;
  329.   OldType  : TNativeType;
  330.   Rect     : TRect;
  331.   MyMenu   : HMenu;
  332. begin
  333.   MyMenu := GetMenu(HWindow);
  334.  
  335.   DocPtr   := POleApp(Application)^.Server^.Document;
  336.   ObjectPtr:= DocPtr^.OleObject;
  337.   OldType  := ObjectPtr^.GetType;
  338.  
  339.   if NewType <> OldType then
  340.   begin
  341.     { Change the object's type which marks the document as 'dirty' and
  342.       notifies each linked object of the change.  Then invalidate
  343.       the window to redraw the object, and update the menu to reflect
  344.       the changes.
  345.     }
  346.     ObjectPtr^.SetType(NewType);
  347.  
  348.     InvalidateRect(HWindow, nil, True);
  349.     CheckMenuItem(MyMenu, NativeTypeToCm[OldType], mf_Unchecked);
  350.     CheckMenuItem(MyMenu, NativeTypeToCm[NewType], mf_Checked);
  351.   end;
  352. end;
  353.  
  354. { Changes the File/Save As... menu item to File/Save Copy As...
  355.   when an embedded document is being edited.
  356. }
  357. procedure TServerWindow.BeginEmbedding;
  358. var
  359.   MyMenu : HMenu;
  360. begin
  361.   MyMenu := GetMenu(HWindow);
  362.   ModifyMenu(MyMenu, cm_FileSaveAs, mf_ByCommand or mf_String, cm_FileSaveAs, 'Save Copy &As...');
  363. end;
  364.  
  365. { Changes File/Save Copy As..., File/Exit & Return, and
  366.   File/Update menu entries to reflect the end of embedded editing.
  367. }
  368. procedure TServerWindow.EndEmbedding;
  369. var
  370.   MyMenu : HMenu;
  371. begin
  372.   MyMenu := GetMenu(HWindow);
  373.   ModifyMenu(MyMenu, cm_FileSaveAs, mf_ByCommand or mf_String,
  374.     cm_FileSaveAs, 'Save &As...');
  375.   ModifyMenu(MyMenu, cm_Exit,       mf_ByCommand or mf_String,
  376.     cm_Exit,       'E&xit');
  377.   ModifyMenu(MyMenu, cm_FileUpdate, mf_ByCommand or mf_String,
  378.     cm_FileSave,   '&Save');
  379. end;
  380.  
  381. { Changes the  File/Save to File/Update <Client Document> and
  382.   File/Exit to File/Exit & Return to <Client Document> in response
  383.   to a SetHostNames callback from the Client.
  384. }
  385. procedure TServerWindow.UpdateFileMenu(DocName: PChar);
  386. var
  387.   MyMenu : HMenu;
  388.   Buf    : array [0..127] of Char;
  389. begin
  390.   MyMenu := GetMenu(HWindow);
  391.  
  392.   StrCopy(Buf, '&Update ');
  393.   StrCat(Buf, DocName);
  394.   ModifyMenu(MyMenu, cm_FileSave, mf_ByCommand or mf_String,
  395.     cm_FileUpdate, Buf);
  396.  
  397.   StrCopy(Buf, '&Exit and Return to ');
  398.   StrCat(Buf, DocName);
  399.   ModifyMenu(MyMenu, cm_Exit, mf_ByCommand or mf_String, cm_Exit, Buf);
  400. end;
  401.  
  402. { Draws the object in Self's client area, by requesting the OLE Server
  403.   to perform the paint with our DC.
  404. }
  405. procedure TServerWindow.Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
  406. begin
  407.   SetViewportOrg(PaintDC, ObjX, ObjY);
  408.   POleApp(Application)^.Server^.Document^.OleObject^.Draw(PaintDC);
  409. end;
  410.  
  411. end.
  412.  
  413.